home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / shells / scsh-0.4 / scsh-0 / scsh-0.4.2 / rts / fluid.scm < prev    next >
Text File  |  1995-10-13  |  3KB  |  90 lines
  1. ; Copyright (c) 1993, 1994 Richard Kelsey and Jonathan Rees.  See file COPYING.
  2.  
  3. ; This is file fluid.scm.
  4.  
  5. ; Fluid (dynamic) variables.
  6.  
  7. ; Fluid variables are implemented using deep binding.  This allows
  8. ; each thread in a multiprocessor system to have its own fluid
  9. ; environment, and allows for fast thread switching in a multitasking
  10. ; one.
  11.  
  12. ; get-dynamic-state and set-dynamic-state! access a special virtual
  13. ; machine register.  On a multiprocessor, each processor has its own
  14. ; dynamic-state register.  The run-time system stores the current
  15. ; thread in the dynamic-state register.
  16.  
  17. ; Here we define a particular thread record, but a different one is
  18. ; defined by the (uniprocessor) threads package.  The current thread
  19. ; may actually be any kind of record as long as its first component
  20. ; can be used by the fluid variable implementation to maintain the
  21. ; deep-binding dynamic environment.  This is kind of gross but it is
  22. ; motivated by efficiency concerns.
  23.  
  24. (define-record-type thread :thread
  25.   (make-thread dynamic-env)
  26.   (dynamic-env thread-dynamic-env))
  27.  
  28. (define (current-thread) (get-dynamic-state))
  29. (define (set-current-thread! thread) (set-dynamic-state! thread))
  30.  
  31. (define (get-dynamic-env)
  32.   (record-ref (current-thread) 1))
  33. (define (set-dynamic-env! env)
  34.   (record-set! (current-thread) 1 env))
  35.  
  36. (define (initialize-dynamic-state!)
  37.   (set-dynamic-state! (make-thread (empty-dynamic-env))))
  38.  
  39.  
  40. ; Dynamic environment
  41.  
  42. (define (with-dynamic-env env thunk)
  43.   (let ((saved-env (get-dynamic-env)))
  44.     (set-dynamic-env! env)
  45.     (set! env #f)            ;For GC and debugger
  46.     (call-with-values
  47.     ;; thunk
  48.     (let ((x thunk)) (set! thunk #f) x) ;For GC
  49.       (lambda results
  50.     (set-dynamic-env! saved-env)
  51.     (apply values results)))))
  52.  
  53. (define (empty-dynamic-env) '())
  54.  
  55.  
  56. ; Fluids
  57.  
  58. (define-record-type fluid :fluid
  59.   (make-fluid top)
  60.   (top fluid-top-level-value set-fluid-top-level-value!))
  61.  
  62. (define (fluid f)
  63.   (let ((probe (assq f (get-dynamic-env))))
  64.     (if probe (cdr probe) (fluid-top-level-value f))))
  65.  
  66. (define (set-fluid! f val)
  67.   (let ((probe (assq f (get-dynamic-env))))
  68.     (if probe (set-cdr! probe val) (set-fluid-top-level-value! f val))))
  69.  
  70. (define (let-fluid f val thunk)
  71.   (with-dynamic-env (cons (cons f val) (get-dynamic-env)) thunk))
  72.  
  73. (define (let-fluids . args)
  74.   (let loop ((args args)
  75.          (env (get-dynamic-env)))
  76.     (if (null? (cdr args))
  77.     (with-dynamic-env env (car args))
  78.     (loop (cddr args)
  79.           (cons (cons (car args) (cadr args)) env)))))
  80.  
  81. (define (fluid-lookup env f)
  82.   (let ((probe (assq f env)))
  83.     (if probe (cdr probe) (fluid-top-level-value f))))
  84.  
  85.  
  86. ; Initialize
  87.  
  88. (initialize-dynamic-state!)
  89.  
  90.